Grafik als screenshot

[bitsetter]

Hallo,

Zitat:

Zitat von Hartfrid Krause

Außerdem:
ih würde gerne den label1.caption dann jeweils an der Mausspitze haben, um den Ländernamen quasi "auf" dem Land zu haben, wenn ich drüberfahre

Wie das geht, weiss ich nicht
:wall:

wer hilft??

dazu ist mir was eingefallen, man kann einen Cursor für Paintbox2 erstellen, der den Namen der Bundesländer dann anzeigt.

Delphi-Quellcode:

  
  private
    Bitmap2: TBitmap;//Bild im Speicher
    NewCursor: TIcon;//selbst erstellter Cursor
    CursorText: AnsiString;//Text des Cursors
  public
    { Public declarations }
  end;

//...

procedure TForm1.FormShow(Sender: TObject);
begin     
  NewCursor:= TIcon.Create;//Cursor mit Text
  CursorText:= ' ';

  Bitmap2 := TBitmap.Create;
  Bitmap2.LoadFromFile('bildbundeslaender.bmp');//Bild mit schon eingefärbten Bundesländern
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  NewCursor.Free;
  Bitmap2.Free;
end;

//einen Cursor mit Text erstellen und zuweisen
procedure SetTextCursor(Text: AnsiString; var NewCursor: TIcon; Contr: TControl);
var
  ImageList: TImageList;
  BildTemp: TBitmap;
const
  FadenKreuzWidth = 10;
begin
  BildTemp := TBitmap.Create;
  try
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
      BildTemp.Width := BildTemp.Canvas.TextWidth(Text);
      if BildTemp.width < FadenKreuzWidth then
        BildTemp.width := FadenKreuzWidth+ 1;
      BildTemp.Height := 38;
    end;
    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
    begin
      BildTemp.width := 32;
      BildTemp.Height := 32;
    end;
    BildTemp.Canvas.Brush.Color:= clWhite- 10;
    if Assigned(NewCursor) then
      NewCursor.Free;
    NewCursor:= TIcon.Create;
    NewCursor.Width := BildTemp.Width;
    NewCursor.Height := BildTemp.Height;
    ImageList:= TImageList.CreateSize(BildTemp.width, BildTemp.height);
    try
      if Text <> '' then
        BildTemp.Canvas.TextOut(0, 0, Text);
      BildTemp.Canvas.MoveTo(BildTemp.Width div 2- FadenKreuzWidth div 2, 19);
      BildTemp.Canvas.LineTo(BildTemp.Width div 2+ (FadenKreuzWidth div 2)+ 1, 19);
      BildTemp.Canvas.MoveTo(BildTemp.Width div 2, 14);
      BildTemp.Canvas.LineTo(BildTemp.Width div 2, 25);

      ImageList.AddMasked(BildTemp, clWhite);
      ImageList.GetIcon(0, NewCursor);

      Screen.Cursors[0] := NewCursor.Handle;
      Contr.Cursor := 1;
    finally
      ImageList.Free;
    end;
  finally
    BildTemp.Free;
  end;  
end;

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); 
var
  NewText: AnsiString;
begin
  NewText := '';
  if (X <= Bitmap2.Width) and (Y <= Bitmap2.Height) then
    case Bitmap2.canvas.pixels[X, Y] of//Pixel vom Bild im Speicher auslesen
     clcream:label1.Caption:='Nordrhein-Westfalen';
     $0005727A:label1.Caption:='Rheinland-Pfalz';
     $006F6F11:label1.Caption:='Niedersachsen';
     $00C551D9:label1.Caption:='Hessen';
     ... 
    end;

  if NewText <> CursorText then
  begin
    CursorText := NewText;               //Control mit geändertem Cursor
    SetTextCursor(CursorText, NewCursor, PaintBox2);//einen Cursor mit Text erstellen
  end;
    end;
end;

[Hartfrid Krause]

Klasse, es klappt
Dank an bitsetter

[bitsetter]

Hallo,

schön dass es jetzt endlich klappt :)

Funktioniert das mit dem Cursor auch, denn ich habe noch einen kleinen Fehler entdeckt:

Delphi-Quellcode:

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
  NewText: AnsiString;
begin
  NewText := '';
  if (X <= Bitmap2.Width) and (Y <= Bitmap2.Height) then
    case Bitmap2.canvas.pixels[X, Y] of
     //anstatt label1.Caption muss hier natürlich immer "NewText:=" stehen
     clcream:NewText:='Nordrhein-Westfalen';
     $0005727A:NewText:='Rheinland-Pfalz';
     $006F6F11:NewText:='Niedersachsen';
     $00C551D9:NewText:='Hessen';
     ...
    end;

  if NewText <> CursorText then
  begin
    CursorText := NewText;               //Control mit geändertem Cursor
    SetTextCursor(CursorText, NewCursor, PaintBox2);//einen Cursor mit Text erstellen
  end;
    end;
end;