Solved

DBGrid like Emule Plus with loading and picture

Posted on 2006-07-10
8
326 Views
Last Modified: 2010-04-05
I would like to create a dbgrid like on this program (emule plus), here is the image of dbgrid.

http://www.nucleodaweb.com.br/emule.jpg


I would like to put loading and pictures showing the status like that.

PLESE HELP ME to do that.

0
Comment
Question by:rafaelrgl
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 17

Accepted Solution

by:
TheRealLoki earned 250 total points
ID: 17078313
use a TListView with ViewStyle vsReport, and use the OnCustomDrawSubItem event
here's an example

    lvDownloadableFiles: TListView;


    procedure lvDownloadableFilesCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);


// This routine will try to determine the "rectangle" for a particular subitem in the listview
procedure ListView_GetSubItemRect(ListView: TCustomListview; Item: TListItem; SubItem: integer; var Rect_: TRect);
    var
        ColLeft: integer;
        i: integer;
   begin
        Rect_.TopLeft := item.Position;
        Rect_.Left := Rect_.Left - 2; // actual x position start

        ColLeft := Rect_.Left; //ARect.Left;
        for i := 0 to (SubItem-1) do
          ColLeft := ColLeft + ListView.Column[i].Width;
        Rect_.Left := ColLeft;
// Calculate bounding rectangle of selected column
        Rect_.Right := Rect_.Left + ListView.Column[SubItem].Width;
        Rect_.Bottom := 4 + Rect_.Top + ListView.Canvas.TextHeight('W');

    end;


(*This is the hugely complicated drawing routine for the top listview. it lets us
show the "download byte count" and a graphical custom drawn progress bar.*)
procedure TfMultiFileDownloaderMain.lvDownloadableFilesCustomDrawSubItem(
  Sender: TCustomListView; Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; var DefaultDraw: Boolean);
    var
        colBounds: TRect;
        progressbarrect: TRect;
        progressrect: TRect;

        lastcolor: tcolor;
        currentx: integer;
        progresspercent: integer;
        texttoprint: string;
    begin
// highlighting isn't working yet :-( sorry. Loki

        if SubItem = 2 then
        begin
            with (Sender as TCustomListView).Canvas do
            begin
    (* This ensures the correct highlight color is used *)
                lastcolor  := Brush.Color;
                ListView_GetSubItemRect((Sender as TCustomListView), Item, SubItem, ColBounds);

                FillRect(ColBounds);
                if assigned(Item.Data) then
                  texttoprint := FloatToStr(TDownloadableFile(Item.Data).TotalFileSize)
                else texttoprint := '?';

                TextOut(ColBounds.Left, ColBounds.Top, texttoprint);
            end;
            Brush.Color := lastcolor;
            DefaultDraw := false;
        end
        else if SubItem = 3 then
        begin
            with (Sender as TCustomListView).Canvas do
            begin
    (* This ensures the correct highlight color is used *)
                lastcolor  := Brush.Color;
                ListView_GetSubItemRect((Sender as TCustomListView), Item, SubItem, ColBounds);

                FillRect(ColBounds);
                if assigned(Item.Data) then
                  texttoprint := FloatToStr(TDownloadableFile(Item.Data).BytesDownloaded)
                else texttoprint := '?';

                Brush.Color := clBlack;
                TextOut(ColBounds.Left, ColBounds.Top, texttoprint);
            end;
            Brush.Color := lastcolor;
            DefaultDraw := false;
        end

        else if SubItem = 4 then
        begin

//    aTextRect:=Item.DisplayRect(drLabel);


            ListView_GetSubItemRect((Sender as TCustomListView), Item, SubItem, ColBounds);
//(*test works*)            (Sender as TCustomListView).Canvas.TextOut(ColBounds.Left , ColBounds.Top, 'test');

            with (Sender as TCustomListView).Canvas do
            begin
    (* This ensures the correct highlight color is used *)
                lastcolor  := Brush.Color;
//                    Brush.Color := clNavy;
                FillRect(ColBounds);

    // outline of progress bar
                progressbarrect.Top := ColBounds.Top;
                progressbarrect.Left := ColBounds.Left;
                progressbarrect.Bottom := ColBounds.Bottom;
                progressbarrect.Right := (progressbarrect.Left + 57);

                lastcolor  := Brush.Color;
                InflateRect(progressbarrect,-2,-2);
// highlighting isn't working yet. The following is my feeble attempts to get it going so far :-)
                if ( (cdsSelected in State) and ((Sender AS TCustomListView).RowSelect) ) then
                begin
//                    Brush.Color := clNavy;
//                    FillRect(ColBounds);
//                    Font.Color := clWhite;
                  Brush.Color := clBlack;
                end
                else
                  Brush.Color := clBlack;
                (Sender as TCustomListView).Canvas.FrameRect(progressbarrect);

    // actual progress
                if assigned(Item.Data) then
                  progresspercent := TDownloadableFile(Item.Data).DownloadPercent
                else
                  progresspercent := 0;
                if progresspercent > 0 then
                begin
                    progressrect.Top := progressbarrect.Top + 1;
                    progressrect.Left := progressbarrect.Left + 1;
                    progressrect.Bottom := progressbarrect.Bottom - 1;
                    progressrect.Right := progressrect.Left + 1 + (progresspercent div 2); // to get 1-100 to 1-50 pixels
                    Brush.Color := clLime;
                    (Sender as TCustomListView).Canvas.FillRect(progressrect);
                end;
                Brush.Color := lastcolor;
                currentx := ColBounds.Left + (progressbarrect.Right - progressbarrect.Left) + 4 + 2;
//                TextOut(currentx, ColBounds.Top, 'here'); //lbConnections.items[Index]);

                DefaultDraw := false;

            end;
        end;
    end;
0
 
LVL 17

Expert Comment

by:TheRealLoki
ID: 17078521
Pretty brave putting a link to your emule picture that shows you downloading serial codes and cracks for Delphi
0
 
LVL 10

Expert Comment

by:atul_parmar
ID: 17079321
Mate, the grid in your eye is Virtual tree. You can download it from http://www.delphi-gems.com/VirtualTreeview/. Also check for the demo what shows how to achieve the thing you like.
0
 
LVL 10

Assisted Solution

by:atul_parmar
atul_parmar earned 50 total points
ID: 17079341
also visit the gallery http://www.delphi-gems.com/VirtualTreeview/VTGallery.php (OctalWorks)
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 
LVL 11

Assisted Solution

by:calinutz
calinutz earned 200 total points
ID: 17085278
Do you need the DBGrid to look like that? Or a simple StringGrid?
For DBGrid you may find the solution on this page:
http://delphi.about.com/library/weekly/aa032205a.htm

And for StringGrid it's tricky but can be done:
Watch this code and dfm:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, JvGIF, ExtCtrls;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Image1: TImage;
    Image2: TImage;
    procedure FormShow(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
StringGrid1.ColWidths[0]:=30;
StringGrid1.ColWidths[1]:=30;
StringGrid1.ColWidths[2]:=30;
StringGrid1.ColWidths[3]:=120;
StringGrid1.ColWidths[4]:=70;
StringGrid1.ColWidths[5]:=70;
StringGrid1.Refresh;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
   Rect2:TRect;
begin
 // here you must adjust a little bit the picture to stay in the middle of the cell
 If (ACol=0)  and (ARow<>0) then
  StringGrid1.Canvas.Draw(Rect.Left+6, Rect.Top+1, Image1.Picture.Graphic);
 If (ACol=1)  and (ARow<>0) then
  StringGrid1.Canvas.Draw(Rect.Left+6, Rect.Top+1, Image2.Picture.Graphic);


  If (ACol=3) and (ARow=1) then
  begin
    Rect2:=Rect;
    Rect2.Left:=Rect2.Left+3;
    Rect2.Top:=Rect2.Top+2;
    Rect2.Right:=Rect2.Right-3;
    Rect2.Bottom:=Rect2.Bottom-2;
    StringGrid1.Canvas.Brush.Color:=clRed;
    StringGrid1.Canvas.Brush.Style:=bsSolid;
    StringGrid1.Canvas.FillRect(Rect2);
    StringGrid1.canvas.textout(Rect2.Left+10, rect2.Top, '0%');
    end;

  If (ACol=3) and (ARow=2) then
  begin
    Rect2:=Rect;
    Rect2.Left:=Rect2.Left+3;
    Rect2.Top:=Rect2.Top+2;
    Rect2.Right:=Rect2.Right-20;
    Rect2.Bottom:=Rect2.Bottom-2;
    StringGrid1.Canvas.Brush.Color:=$00FFCF9F;
    StringGrid1.Canvas.Brush.Style:=bsSolid;
    StringGrid1.Canvas.FillRect(Rect2);
    StringGrid1.canvas.textout(Rect2.Left+10, rect2.Top, '80%');
    end;
end;

end.
0
 
LVL 11

Expert Comment

by:calinutz
ID: 17085280
And the dfm:
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 565
  Height = 307
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 328
    Top = 252
    Width = 25
    Height = 25
    Picture.Data = {
      07544269746D617036030000424D360300000000000036000000280000001000
      000010000000010018000000000000030000120B0000120B0000000000000000
      0000FF00FFFF00FFFF00FFFF00FFFF00FF767574868483868483FF00FFFF00FF
      FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF7876
      76ABAAAAE5E5E5C5C5C4868483868483868483FF00FFFF00FFFF00FFFF00FFFF
      00FFFF00FFFF00FFFF00FF7F7E7DB4B4B4FFFFFFF8F8F8E7E7E7EEE7E3749EB5
      074D7D285875657276868483FF00FFFF00FFFF00FFFF00FF81807FC4C2C2FFFF
      FFFFFFFFFAFAFAEBEBEBF4EDE978A3BA0047800045806E98ACB7B2B08684835E
      5E5DFF00FF868483D7D7D7FFFFFFFFFFFFFFFFFFFCFCFCF3F3F3FCF4F07EA9C0
      00488000467F789EB1D0CCCAB2B2B25C5C5BFF00FF868483FCFCFCFFFFFFFFFF
      FFFFFFFFFFFFFFFBFBFBFFFEFA82ADC500488000457F7DA3B7D4D0CFB4B4B25C
      5C5BFF00FF868483FFFEFEFFFFFF9FB1BD678499C5D0D7FFFFFFFFFFFF7FADC6
      003F790040797FA7BBDDD9D8B8B8BA5F5D5BFF00FF868483E5E7E94F73890041
      6E0041750C4268BCC9CFFFFFFFD8E6EE7BAAC53A7DA498B7C7E2E0DECBC6C43A
      4A53FF00FF868483174769005289007FBD0079B6004C870D4064BDC9CFFFFFFF
      FFFFFFF7F6F4E9E9EAEEEBEAC1C1C116394EFF00FF07476D006CA90086C2007F
      BB007DB80074B0004B820C3E5EBCC9CFFFFFFFFCFCFCFFFFFFB5BFC41B496600
      3866FF00FF00538B0088C60081BD007FBB007BB70078B40072AC0049810D3D5F
      C0CBD1FFFFFF8197A5043253004074FF00FFFF00FF00538B0076B20083C0007F
      BB007BB70077B20074AF006DA9004B82114365416275002F5500487FFF00FFFF
      00FFFF00FFFF00FF00528A007DB80080BC007BB70077B2047EBB0F93D5006AA5
      004C82003562004A81FF00FFFF00FFFF00FFFF00FFFF00FFFF00FF005A930079
      B5007EBA0078B40F93D40F93D5006DA900568FFF00FFFF00FFFF00FFFF00FFFF
      00FFFF00FFFF00FFFF00FFFF00FF0058900076B1007BB80058900170A500679F
      005890FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
      FF005991005890FF00FF005890005890FF00FFFF00FFFF00FFFF00FFFF00FFFF
      00FF}
    Transparent = True
  end
  object Image2: TImage
    Left = 356
    Top = 252
    Width = 25
    Height = 25
    Picture.Data = {
      07544269746D617036030000424D360300000000000036000000280000001000
      000010000000010018000000000000030000120B0000120B0000000000000000
      0000FF00FFFF00FFFF00FFFF00FFFF00FF044906055B09066C0C066C0C055E0A
      044C06FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FF0560090560
      0908911309B01809B31A09B31909B11907961405680C05680CFF00FFFF00FFFF
      00FFFF00FFFF00FF0A6A150A7F150BB61C09B91A08B41807B21609B31909B419
      09B81A09B91A078310044D06FF00FFFF00FFFF00FF0B6A150F852216BD3411B7
      270BB21C07B11608B11709B21909B21909B21909B41909BA1A07841006670CFF
      00FFFF00FF0B6A1520BE491BBD4014B7300AB21F28BC36DFF5E1EEFAEF63CE6D
      09B21909B21909B31909BA1A06670CFF00FF0872101B9A3A2AC65B1DBB450EB4
      250BB31B11B4219ADFA0FFFFFFF7FDF85ACB6509B21909B21909B81A08941304
      5D090872102AB65B2CC56522BD4D0FB4220AB21A0CB31C0AB2198DDB95FDFEFD
      F6FCF758CB6309B21909B51A08AB17045D090F821C37C26C33C76CCDF1DAC9EF
      D3C7EED0C8EFD2C5EED0C7EECFF8FDF9FFFFFFF2FBF36FD27908B41909B31905
      650B138D2358CC8342C977FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFDFEFD
      FFFFFFFFFFFFBCEAC10AB41A09B319066D0D0F911D6FD2935FD38D6DD49572D6
      9971D69872D69964D28C92DFA8FBFEFBFFFFFFACE5B82EBF4C11B82B08B11905
      610A0F911D67CC839BE5BA38C67030C36938C56F38C56F70D697E8F8EEFFFFFF
      9FE2B120BD481AB93E10BA2908A31705610AFF00FF25AE39BCEDD282DBA428C0
      632FC26753CD82F7FDF9FFFFFF9CE2B222BC4B1DBA4118B73614C0300A8517FF
      00FFFF00FF25AE3971D28CD2F4E180DAA336C46D39C56FBCECCEABE6C22DC263
      24BE5623BC4D1FC14616AE340A8517FF00FFFF00FFFF00FF25AE3984D89FDBF7
      EAAFE8C66BD49352CC8144C97849CA7B48CB7839CB6A21B6490F7C1FFF00FFFF
      00FFFF00FFFF00FFFF00FF25AE3925AE39ADE8C5CCF2DEBAEDD1A6E7C291E2B3
      64D4922FB1572FB157FF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00FFFF00
      FF32B74E25AE3925AE3925AE3925AE3924A342FF00FFFF00FFFF00FFFF00FFFF
      00FF}
    Transparent = True
  end
  object StringGrid1: TStringGrid
    Left = 0
    Top = 0
    Width = 525
    Height = 245
    ColCount = 6
    Ctl3D = False
    DefaultColWidth = 80
    DefaultRowHeight = 17
    FixedCols = 0
    RowCount = 6
    ParentCtl3D = False
    TabOrder = 0
    OnDrawCell = StringGrid1DrawCell
  end
end
0
 
LVL 11

Expert Comment

by:calinutz
ID: 17085284
And by the way... the link you gave in the question is quite interesting... :))))


Regards
0
 
LVL 1

Author Comment

by:rafaelrgl
ID: 17085955
Thank's a lot, you helped me to build the greatest dbgrid.
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Here's a very brief overview of the methods PRTG Network Monitor (https://www.paessler.com/prtg) offers for monitoring bandwidth, to help you decide which methods you´d like to investigate in more detail.  The methods are covered in more detail in o…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now